;; core/lambdaL.scm - (c) rohan drape, 2000-2005

;; A let variant that matches on <list>s.
;; NOTE: The notation for a value is a unary tuple...

(define-syntax letL
  (syntax-rules ()
;    ((_ (({n} v)) expr ...)
;     (let ((n v)) expr ...))
    ((_ (({n1 n2 ...} v)) expr ...)
     (match-let (({list n1 n2 ...} v)) expr ...))
    ((_ ((n v)) expr ...)
     (let ((n v)) expr ...))
    ((_ ((n1 v1) (n2 v2) ...) expr ...)
     (letL ((n1 v1)) (letL ((n2 v2) ...) expr ...)))))

;; Variant <function> constructor.  The arguments are given as tuples.

(define-syntax lambdaLl
  (syntax-rules ()
    ((_ lambda (name) expr ...)
     (lambda (value) 
       (letL ((name value)) expr ...)))
    ((_ lambda (n1 n2) x ...)
     (lambda (v1 v2) 
       (letL ((n1 v1) (n2 v2)) x ...)))
    ((_ lambda (n1 n2 n3) x ...)
     (lambda (v1 v2 v3) 
       (letL ((n1 v1) (n2 v2) (n3 v3)) x ...)))
    ((_ lambda (n1 n2 n3 n4) x ...)
     (lambda (v1 v2 v3 v4) 
       (letL ((n1 v1) (n2 v2) (n3 v3) (n4 v4)) x ...)))
    ((_ lambda (n1 n2 n3 n4 n5) x ...)
     (lambda (v1 v2 v3 v4 v5) 
       (letL ((n1 v1) (n2 v2) (n3 v3) (n4 v4) (n5 v5)) x ...)))))

(define-syntax lambdaL
  (syntax-rules ()
    ((_ a ...) (lambdaLl lambda a ...))))

(define-syntax defineL
  (syntax-rules ()
    ((_ (name var ...) expr ...)
     (define name (lambdaL (var ...) expr ...)))
    ((_ name value) 
     (define name value))))

(define (as/l p) 
  (lambda (value) (apply p value)))

(define-syntax lambdaH
  (syntax-rules ()
    ((_ a ...) (lambdaLl lambdaC a ...))))

(define-syntax defineH
  (syntax-rules ()
    ((_ (name var ...) expr ...)
     (define name (lambdaH (var ...) expr ...)))
    ((_ name value) 
     (define name value))))
